home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / buildq.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  7.2 KB  |  203 lines
  1. ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;     The data in this file contains enhancments.                    ;;;;;
  4. ;;;                                                                    ;;;;;
  5. ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
  6. ;;;     All rights reserved                                            ;;;;;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;     (c) Copyright 1980 Massachusetts Institute of Technology         ;;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. (in-package "MAXIMA")
  12. (macsyma-module buildq)
  13.  
  14. ; Exported functions are $BUILDQ and MBUILDQ-SUBST
  15. ; TRANSLATION property for $BUILDQ in MAXSRC;TRANS5 >
  16.  
  17. ;**************************************************************************
  18. ;******                                                              ******
  19. ;******      BUILDQ:  A backquote-like construct for Macsyma         ******
  20. ;******                                                              ******
  21. ;**************************************************************************
  22.  
  23.  
  24.  
  25. ;DESCRIPTION:
  26.  
  27.  
  28. ; Syntax: 
  29.  
  30. ; BUILDQ([<varlist>],<expression>);
  31.  
  32. ; <expression> is any single macsyma expression
  33. ; <varlist> is a list of elements of the form <atom> or <atom>:<value>
  34.  
  35.  
  36. ; Semantics:
  37.  
  38. ; the <value>s in the <varlist> are evaluated left to right (the syntax
  39. ; <atom> is equivalent to <atom>:<atom>).  then these values are substituted
  40. ; into <expression> in parallel.  If any <atom> appears as a single 
  41. ; argument to the special form SPLICE (i.e. SPLICE(<atom>) ) inside
  42. ; <expression>, then the value associated with that <atom> must be a macsyma
  43. ; list, and it is spliced into <expression> instead of substituted.
  44.  
  45.  
  46.  
  47.  
  48.  
  49. ;SIMPLIFICATION:
  50.  
  51.  
  52. ; the arguments to $BUILDQ need to be protected from simplification until
  53. ; the substitutions have been carried out.  This code should affect that.
  54.  
  55. (DEFPROP $BUILDQ SIMPBUILDQ OPERATORS)
  56. (DEFPROP %BUILDQ SIMPBUILDQ OPERATORS)
  57.  
  58. ; This is modeled after SIMPMDEF, SIMPLAMBDA etc. in JM;SIMP >
  59.  
  60. (DEFUN SIMPBUILDQ (X *IGNORE* SIMP-FLAGS)
  61.        *IGNORE*   ; no simplification takes place.
  62.        SIMP-FLAGS ; ditto.
  63.        (CONS '($BUILDQ SIMP) (CDR X)))
  64.  
  65. ; Note that supression of simplification is very important to the semantics
  66. ; of BUILDQ.  Consider BUILDQ([A:'[B,C,D]],SPLICE(A)+SPLICE(A));
  67.  
  68. ; If no simplification takes place, $BUILDQ returns B+C+D+B+C+D.
  69. ; If the expression is simplified into 2*SPLICE(A), then 2*B*C*D results.
  70.  
  71.  
  72.  
  73. ;INTERPRETIVE CODE:
  74.  
  75.  
  76. (DEFMSPEC $BUILDQ (FORM) (SETQ FORM (CDR FORM))
  77.   (COND ((OR (NULL (CDR FORM))
  78.          (CDDR FORM))
  79.      (MERROR "BUILDQ takes 2 args:~%~M" `(($BUILDQ) ,@FORM)))
  80.     (T (MBUILDQ (CAR FORM) (CADR FORM)))))
  81.  
  82. ; this macro definition is NOT equivalent because of the way lisp macros
  83. ; are currently handled in the macsyma interpreter.  When the subr form
  84. ; is returned the arguments get MEVAL'd (and hence simplified) before
  85. ; we get ahold of them.
  86.  
  87. ; Lisp MACROS, and Lisp FEXPR's are meaningless to the macsyma evaluator
  88. ; and should be ignored, the proper things to use are MFEXPR* and
  89. ; MMACRO properties.  -GJC
  90.  
  91. ;(DEFMACRO ($BUILDQ DEFMACRO-FOR-COMPILING T)
  92. ;          (VARLIST . EXPRESSIONS)
  93. ;   (COND ((OR (NULL VARLIST)
  94. ;           (NULL EXPRESSIONS)
  95. ;           (CDR EXPRESSIONS))
  96. ;       (DISPLA `(($BUILDQ) ,VARLIST ,@EXPRESSIONS))
  97. ;       (MERROR "BUILDQ takes 2 args"))
  98. ;      (T `(MBUILDQ ',VARLIST ',(CAR EXPRESSIONS)))))
  99.  
  100.  
  101. (DEFUN MBUILDQ (VARLIST EXPRESSION)
  102.  (COND ((NOT ($LISTP VARLIST))
  103.     (MERROR "First arg to BUILDQ not a list: ~M" VARLIST)))
  104.  (MBUILDQ-SUBST
  105.   (MAPCAR #'(LAMBDA (FORM)             ; make a variable/value alist
  106.            (COND ((SYMBOLP FORM)
  107.               (CONS FORM (MEVAL FORM)))
  108.              ((AND (EQ (CAAR FORM) 'MSETQ)
  109.                (SYMBOLP (CADR FORM)))
  110.               (CONS (CADR FORM) (MEVAL (CADDR FORM))))
  111.              (T 
  112.             (MERROR "Illegal form in variable list--BUILDQ: ~M"
  113.                 FORM
  114.                 ))))
  115.       (CDR VARLIST))
  116.   EXPRESSION))
  117.  
  118.  
  119. ; this performs the substitutions for the variables in the expressions.
  120. ; it tries to be smart and only copy what list structure it has to.
  121. ; the first arg is an alist of pairs:  (<variable> . <value>)
  122. ; the second arg is the macsyma expression to substitute into.
  123.  
  124. (DEFMFUN MBUILDQ-SUBST (ALIST EXPRESSION)
  125.  (PROG (NEW-CAR)
  126.        (COND ((ATOM EXPRESSION)
  127.           (RETURN (MBUILDQ-ASSOCIATE EXPRESSION ALIST)))
  128.          ((ATOM (CAR EXPRESSION))
  129.           (SETQ NEW-CAR (MBUILDQ-ASSOCIATE (CAR EXPRESSION) ALIST)))
  130.          ((MBUILDQ-SPLICE-ASSOCIATE EXPRESSION ALIST)
  131.           ; if the expression is a legal SPLICE, this clause is taken.
  132.           ; a SPLICE should never occur here.  It corresponds to `,@form
  133.           
  134.           (MERROR "SPLICE used in illegal context: ~M" EXPRESSION))
  135.          ((ATOM (CAAR EXPRESSION))
  136.           (SETQ NEW-CAR (MBUILDQ-ASSOCIATE (CAAR EXPRESSION) ALIST))
  137.           (COND ((EQ NEW-CAR (CAAR EXPRESSION))
  138.              (SETQ NEW-CAR (CAR EXPRESSION)))
  139.             ((ATOM NEW-CAR)
  140.              (SETQ NEW-CAR (CONS NEW-CAR (CDAR EXPRESSION))))
  141.             (T (RETURN
  142.             `(,(CONS 'MQAPPLY (CDAR EXPRESSION))
  143.               ,NEW-CAR
  144.               ,@(MBUILDQ-SUBST ALIST (CDR EXPRESSION)))))))
  145.          ((SETQ NEW-CAR 
  146.             (MBUILDQ-SPLICE-ASSOCIATE (CAR EXPRESSION) ALIST))
  147.           (RETURN (APPEND (CDR NEW-CAR)
  148.                   (MBUILDQ-SUBST ALIST (CDR EXPRESSION)))))
  149.          (T (SETQ NEW-CAR (MBUILDQ-SUBST ALIST (CAR EXPRESSION)))))
  150.        (RETURN
  151.     (LET ((NEW-CDR (MBUILDQ-SUBST ALIST (CDR EXPRESSION))))
  152.          (COND ((AND (EQ NEW-CAR (CAR EXPRESSION))
  153.              (EQ NEW-CDR (CDR EXPRESSION)))
  154.             EXPRESSION)
  155.            (T (CONS NEW-CAR NEW-CDR)))))))
  156.  
  157.  
  158. ; this function returns the appropriate thing to substitute for an atom
  159. ; appearing inside a backquote.  If it's not in the varlist, it's the
  160. ; atom itself.
  161.  
  162. (DEFUN MBUILDQ-ASSOCIATE (ATOM ALIST)
  163.  (LET ((FORM))
  164.       (COND ((NOT (SYMBOLP ATOM))
  165.          ATOM)
  166.         ((SETQ FORM (ASSQ ATOM ALIST))
  167.          (CDR FORM))
  168.         ((SETQ FORM (ASSQ ($VERBIFY ATOM) ALIST))
  169.           ;trying to match a nounified substitution variable
  170.          (COND ((ATOM (CDR FORM))
  171.             ($NOUNIFY (CDR FORM)))
  172.            ((MEMQ (CAAR (CDR FORM)) 
  173.               '(MQUOTE MLIST MPROG MPROGN LAMBDA))
  174.               ;list gotten from the parser.
  175.             `((MQUOTE) ,(CDR FORM)))
  176.            (T `( (,($NOUNIFY (CAAR (CDR FORM)))
  177.               ,@(CDAR (CDR FORM)))
  178.             ,@(CDR (CDR FORM))))))
  179.                  ;; ((<verb> ...) ...)  ==>  ((<noun> ...) ...)
  180.         (T ATOM))))
  181.  
  182. ;; give it a property so it is known as special for bothcases
  183.  
  184. (setf (get '$splice '$bothcases) t)
  185.  
  186. ; this function decides whether the SPLICE is one of ours or not.
  187. ; the basic philosophy is that the SPLICE is ours if it has exactly
  188. ; one symbolic argument and that arg appears in the current varlist.
  189. ; if it's one of ours, this function returns the list it's bound to.
  190. ; otherwise it returns nil.  Notice that the list returned is an 
  191. ; MLIST and hence the cdr of the return value is what gets spliced in.
  192.  
  193. (DEFUN MBUILDQ-SPLICE-ASSOCIATE (EXPRESSION VARLIST)
  194.  (AND (EQ (CAAR EXPRESSION) '$SPLICE)
  195.       (CDR EXPRESSION)
  196.       (NULL (CDDR EXPRESSION))
  197.       (LET ((MATCH (ASSQ (CADR EXPRESSION) VARLIST)))
  198.        (COND ((NULL MATCH) () )
  199.          ((NOT ($LISTP (CDR MATCH)))
  200.           (MERROR "~M returned ~M~%But SPLICE must return a list"
  201.               EXPRESSION (CDR MATCH)))
  202.          (T (CDR MATCH))))))
  203.